home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Library
/
Sets.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
11KB
|
473 lines
(*************************************************************************
$RCSfile: Sets.mod $
Description: A general module for handling sets of all sizes.
Created by: fjc (Frank Copeland)
$Revision: 1.4 $
$Author: fjc $
$Date: 1995/06/04 23:22:41 $
Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
*************************************************************************)
<* STANDARD- *>
MODULE Sets;
(**
** This module serves a number of purposes. It first of all attempts to
** provide a portable interface to the non-standard set variants used by
** a number of Oberon compilers. It also implements a Set class to handle
** sets of any arbitrary size. This is based on an example in Mössenböck's
** "Object-oriented Programming in Oberon-2". Finally, it provides an
** extension of the Set class that emulates Modula-2's SET OF CHAR.
*)
(**
** Portable set variants.
**
** The following types are aliases intended to provide a portable
** interface to the non-standard set types provided by many Oberon
** compilers.
**
** The problem is this: Oberon defines only one set type, which is
** typically implemented as the "natural" word size of the host machine.
** However, many compilers provide set variants in different sizes. The
** logical type hierarchy is LONGSET <- SET <- SHORTSET, with LONGSET
** being 32 bits, SET 16 bits and SHORTSET 8 bits. Unfortunately, the
** Oakwood Report and the defacto standard OP2 compiler do not provide
** for variants, and use 32 bits for SET types. Oberon-A follows this
** standard by making SET 32 bits, but it also provides 16 and 8 bit
** variants, which makes it incompatible with other compilers that use the
** LONGSET/SET/SHORTSET system.
**
** The objective of this module is to provide a portable interface to
** such set variants that can be used with different compilers. The
** implementation will vary depending on the compiler being used, and if a
** particular sized set is not provided it must be emulated.
*)
IMPORT SYSTEM;
TYPE
SET8 *= SYSTEM.BYTESET;
SET16 *= SYSTEM.WORDSET;
SET32 *= SET;
(**
** The Set type defines a class that can be used to create and manage sets
** of any arbitrary size. It is based directly on an example in chapter
** 4.3 of "Object-oriented Programming in Oberon-2".
*)
CONST setSize = MAX (SET) + 1;
TYPE
Set *= RECORD
max -: INTEGER; (* Largest element allowed *)
val : POINTER TO ARRAY OF SET;
END; (* Set *)
(**
** The CharSet class extends the Set class to allow for sets of ASCII
** characters, emulating the SET OF CHAR type that was possible in most
** Modula-2s.
*)
TYPE
CharSet *= RECORD (Set) END;
(**
** The following procedures implement the basic set operations:
**
** - assigning the empty set : s := {} -> Clear? (s)
** - assigning a set value : s := s1 -> Copy? (s, s1)
** - including an element : INCL (s, i) -> Incl? (s, i)
** - excluding an element : EXCL (s, i) -> Excl? (s, i)
** - set union : s := s1 + s2 -> s := Add? (s1, s2)
** - set difference : s := s1 - s2 -> s := Subtract? (s1, s2)
** - set intersection : s := s1 * s2 -> s := Intersect? (s1, s2)
** - symmetric differnece : s := s1 / s2 -> s := SymDiff? (s1, s2)
** - set membership : i IN s -> In? (s, i)
**
** Three versions of each procedure are provided, one for each set type.
** Most of these procedures may seem unnecessary, as they are implemented
** directly using normal set operations. However, when using a compiler
** that does not provide any or all of the set variants as extensions, the
** operations must be implemented using other types, such as SYSTEM.BYTE.
** The procedures allow code using this module to be ported to such a
** compiler without change, as the details of the implementation are
** wrapped in a procedure interface.
**
** Type conversion functions are also provided:
**
** - 8 bit -> 16 bit : Long8()
** - 16 bit -> 32 bit : Long16()
** - 16 bit -> 8 bit : Short16()
** - 32 bit -> 16 bit : Short32()
*)
PROCEDURE Clear8 * ( VAR s : SET8 );
BEGIN (* Clear8 *)
s := {}
END Clear8;
PROCEDURE Copy8 * ( VAR s1 : SET8; s2 : SET8 );
BEGIN (* Copy8 *)
s1 := s2
END Copy8;
PROCEDURE Incl8 * ( VAR s : SET8; i : INTEGER );
BEGIN (* Incl8 *)
INCL (s, i)
END Incl8;
PROCEDURE Excl8 * ( VAR s : SET8; i : INTEGER );
BEGIN (* Excl8 *)
EXCL (s, i)
END Excl8;
PROCEDURE Add8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Add8 *)
RETURN s1 + s2
END Add8;
PROCEDURE Subtract8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Subtract8 *)
RETURN s1 - s2
END Subtract8;
PROCEDURE Intersect8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Intersect8 *)
RETURN s1 * s2
END Intersect8;
PROCEDURE SymDiff8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* SymDiff8 *)
RETURN s1 / s2
END SymDiff8;
PROCEDURE In8 * ( s1 : SET8; i : INTEGER ) : BOOLEAN;
BEGIN (* In8 *)
RETURN i IN s1
END In8;
PROCEDURE Clear16 * ( VAR s : SET16 );
BEGIN (* Clear16 *)
s := {}
END Clear16;
PROCEDURE Copy16 * ( VAR s1 : SET16; s2 : SET16 );
BEGIN (* Copy16 *)
s1 := s2
END Copy16;
PROCEDURE Incl16 * ( VAR s : SET16; i : INTEGER );
BEGIN (* Incl16 *)
INCL (s, i)
END Incl16;
PROCEDURE Excl16 * ( VAR s : SET16; i : INTEGER );
BEGIN (* Excl16 *)
EXCL (s, i)
END Excl16;
PROCEDURE Add16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Add16 *)
RETURN s1 + s2
END Add16;
PROCEDURE Subtract16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Subtract16 *)
RETURN s1 - s2
END Subtract16;
PROCEDURE Intersect16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Intersect16 *)
RETURN s1 * s2
END Intersect16;
PROCEDURE SymDiff16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* SymDiff16 *)
RETURN s1 / s2
END SymDiff16;
PROCEDURE In16 * ( s1 : SET16; i : INTEGER ) : BOOLEAN;
BEGIN (* In16 *)
RETURN i IN s1
END In16;
PROCEDURE Clear32 * ( VAR s : SET32 );
BEGIN (* Clear32 *)
s := {}
END Clear32;
PROCEDURE Copy32 * ( VAR s1 : SET32; s2 : SET32 );
BEGIN (* Copy32 *)
s1 := s2
END Copy32;
PROCEDURE Incl32 * ( VAR s : SET32; i : INTEGER );
BEGIN (* Incl32 *)
INCL (s, i)
END Incl32;
PROCEDURE Excl32 * ( VAR s : SET32; i : INTEGER );
BEGIN (* Excl32 *)
EXCL (s, i)
END Excl32;
PROCEDURE Add32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Add32 *)
RETURN s1 + s2
END Add32;
PROCEDURE Subtract32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Subtract32 *)
RETURN s1 - s2
END Subtract32;
PROCEDURE Intersect32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Intersect32 *)
RETURN s1 * s2
END Intersect32;
PROCEDURE SymDiff32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* SymDiff32 *)
RETURN s1 / s2
END SymDiff32;
PROCEDURE In32 * ( s1 : SET32; i : INTEGER ) : BOOLEAN;
BEGIN (* In32 *)
RETURN i IN s1
END In32;
PROCEDURE Long8 * ( s : SET8 ) : SET16;
BEGIN (* Long8 *)
RETURN LONG (s)
END Long8;
PROCEDURE Long16 * ( s : SET16 ) : SET32;
BEGIN (* Long16 *)
RETURN LONG (s)
END Long16;
PROCEDURE Short16 * ( s : SET16 ) : SET8;
BEGIN (* Short16 *)
RETURN SHORT (s)
END Short16;
PROCEDURE Short32 * ( s : SET32 ) : SET16;
BEGIN (* Short32 *)
RETURN SHORT (s)
END Short32;
<*$IndexChk-*>
PROCEDURE (VAR s : Set) Init * ( max : INTEGER );
BEGIN (* Init *)
s.max := max;
NEW (s.val, (max + setSize) DIV setSize)
END Init;
PROCEDURE (VAR s : Set) CopyTo * ( VAR s1 : Set );
VAR i : INTEGER;
BEGIN (* CopyTo *)
s1.Init (s.max);
FOR i := 0 TO s.max DIV setSize DO s1.val [i] := s.val [i] END
END CopyTo;
PROCEDURE (VAR s : Set) Clear *;
VAR i : INTEGER;
BEGIN (* Clear *)
FOR i := 0 TO s.max DIV setSize DO s.val [i] := {} END
END Clear;
PROCEDURE (VAR s : Set) Incl * ( x : INTEGER );
BEGIN (* Incl *)
IF (x > 0) & (x <= s.max) THEN
INCL (s.val [x DIV setSize], x MOD setSize)
END
END Incl;
PROCEDURE (VAR s : Set) InclRange * ( x, y : INTEGER );
VAR i : INTEGER;
BEGIN (* InclRange *)
IF y < x THEN i := x; x := y; y := i END;
IF x < 0 THEN x := 0 END; IF y > s.max THEN y := s.max END;
FOR i := x TO y DO
INCL (s.val [i DIV setSize], i MOD setSize)
END
END InclRange;
PROCEDURE (VAR s : Set) Excl * ( x : INTEGER );
BEGIN (* Excl *)
IF (x > 0) & (x <= s.max) THEN
EXCL (s.val [x DIV setSize], x MOD setSize)
END
END Excl;
PROCEDURE (VAR s : Set) ExclRange * ( x, y : INTEGER );
VAR i : INTEGER;
BEGIN (* ExclRange *)
IF y < x THEN i := x; x := y; y := i END;
IF x < 0 THEN x := 0 END; IF y > s.max THEN y := s.max END;
FOR i := x TO y DO
EXCL (s.val [i DIV setSize], i MOD setSize)
END
END ExclRange;
PROCEDURE (VAR s : Set) Contains * ( x : INTEGER ) : BOOLEAN;
BEGIN (* Contains *)
RETURN (x > 0) & (x <= s.max)
& (x MOD setSize IN s.val [x DIV setSize])
END Contains;
PROCEDURE (VAR s : Set) Add * ( VAR s1 : Set );
VAR i, max : INTEGER;
BEGIN (* Add *)
max := s.max; IF s1.max < max THEN max := s1.max END;
FOR i := 0 TO max DIV setSize DO
s.val [i] := s.val [i] + s1.val [i]
END
END Add;
PROCEDURE (VAR s : Set) Subtract * ( VAR s1 : Set );
VAR i, max : INTEGER;
BEGIN (* Subtract *)
max := s.max; IF s1.max < max THEN max := s1.max END;
FOR i := 0 TO max DIV setSize DO
s.val [i] := s.val [i] - s1.val [i]
END
END Subtract;
PROCEDURE (VAR s : Set) Intersect * ( VAR s1 : Set );
VAR i, max : INTEGER;
BEGIN (* Intersect *)
max := s.max; IF s1.max < max THEN max := s1.max END;
FOR i := 0 TO max DIV setSize DO
s.val [i] := s.val [i] * s1.val [i]
END
END Intersect;
PROCEDURE (VAR s : Set) SymDiff * ( VAR s1 : Set );
VAR i, max : INTEGER;
BEGIN (* SymDiff *)
max := s.max; IF s1.max < max THEN max := s1.max END;
FOR i := 0 TO max DIV setSize DO
s.val [i] := s.val [i] / s1.val [i]
END
END SymDiff;
PROCEDURE (VAR s : CharSet) Init * ( max : INTEGER );
BEGIN (* Init *)
s.Init^ (ORD (MAX (CHAR)))
END Init;
PROCEDURE (VAR s : CharSet) InclCh * ( ch : CHAR );
BEGIN (* InclCh *)
s.Incl^ (ORD (ch))
END InclCh;
PROCEDURE (VAR s : CharSet) InclChRange * ( ch1, ch2 : CHAR );
BEGIN (* InclChRange *)
s.InclRange^ (ORD (ch1), ORD (ch2))
END InclChRange;
PROCEDURE (VAR s : CharSet) InclStr * ( str : ARRAY OF CHAR );
VAR i : INTEGER; ch : CHAR;
BEGIN (* InclStr *)
i := 0;
LOOP
ch := str [0]; IF ch = 0X THEN EXIT END;
s.Incl^ (ORD (ch)); INC (i)
END
END InclStr;
PROCEDURE (VAR s : CharSet) ExclCh * ( ch : CHAR );
BEGIN (* ExclCh *)
s.Excl^ (ORD (ch))
END ExclCh;
PROCEDURE (VAR s : CharSet) ExclChRange * ( ch1, ch2 : CHAR );
BEGIN (* ExclChRange *)
s.ExclRange^ (ORD (ch1), ORD (ch2))
END ExclChRange;
PROCEDURE (VAR s : CharSet) ExclStr * ( str : ARRAY OF CHAR );
VAR i : INTEGER; ch : CHAR;
BEGIN (* ExclStr *)
i := 0;
LOOP
ch := str [0]; IF ch = 0X THEN EXIT END;
s.Excl^ (ORD (ch)); INC (i)
END
END ExclStr;
PROCEDURE (VAR s : CharSet) ContainsCh * ( ch : CHAR ) : BOOLEAN;
BEGIN (* ContainsCh *)
RETURN s.Contains^ (ORD (ch))
END ContainsCh;
END Sets.